
C   IMSL ROUTINE NAME   - UERTST                                        UERT0010
C                                                                       UERT0020
C-----------------------------------------------------------------------UERT0030
C                                                                       UERT0040
C   COMPUTER            - HP1000/SINGLE                                 UERT0050
C                                                                       UERT0060
C   LATEST REVISION     - JUNE 1, 1982                                  UERT0070
C                                                                       UERT0080
C   PURPOSE             - PRINT A MESSAGE REFLECTING AN ERROR CONDITION UERT0090
C                                                                       UERT0100
C   USAGE               - CALL UERTST (IER,NAME)                        UERT0110
C                                                                       UERT0120
C   ARGUMENTS    IER    - ERROR PARAMETER. (INPUT)                      UERT0130
C                           IER = I+J WHERE                             UERT0140
C                             I = 128 IMPLIES TERMINAL ERROR MESSAGE,   UERT0150
C                             I =  64 IMPLIES WARNING WITH FIX MESSAGE, UERT0160
C                             I =  32 IMPLIES WARNING MESSAGE.          UERT0170
C                             J = ERROR CODE RELEVANT TO CALLING        UERT0180
C                                 ROUTINE.                              UERT0190
C                NAME   - A CHARACTER STRING OF LENGTH SIX PROVIDING    UERT0200
C                           THE NAME OF THE CALLING ROUTINE. (INPUT)    UERT0210
C                                                                       UERT0220
C   PRECISION/HARDWARE  - SINGLE/ALL                                    UERT0230
C                                                                       UERT0240
C   REQD. IMSL ROUTINES - UGETIO,USPKD                                  UERT0250
C                                                                       UERT0260
C   NOTATION            - INFORMATION ON SPECIAL NOTATION AND           UERT0270
C                           CONVENTIONS IS AVAILABLE IN THE MANUAL      UERT0280
C                           INTRODUCTION OR THROUGH IMSL ROUTINE UHELP  UERT0290
C                                                                       UERT0300
C   REMARKS      THE ERROR MESSAGE PRODUCED BY UERTST IS WRITTEN        UERT0310
C                TO THE STANDARD OUTPUT UNIT. THE OUTPUT UNIT           UERT0320
C                NUMBER CAN BE DETERMINED BY CALLING UGETIO AS          UERT0330
C                FOLLOWS..   CALL UGETIO(1,NIN,NOUT).                   UERT0340
C                THE OUTPUT UNIT NUMBER CAN BE CHANGED BY CALLING       UERT0350
C                UGETIO AS FOLLOWS..                                    UERT0360
C                                NIN = 0                                UERT0370
C                                NOUT = NEW OUTPUT UNIT NUMBER          UERT0380
C                                CALL UGETIO(3,NIN,NOUT)                UERT0390
C                SEE THE UGETIO DOCUMENT FOR MORE DETAILS.              UERT0400
C                                                                       UERT0410
C   COPYRIGHT           - 1982 BY IMSL, INC. ALL RIGHTS RESERVED.       UERT0420
C                                                                       UERT0430
C   WARRANTY            - IMSL WARRANTS ONLY THAT IMSL TESTING HAS BEEN UERT0440
C                           APPLIED TO THIS CODE. NO OTHER WARRANTY,    UERT0450
C                           EXPRESSED OR IMPLIED, IS APPLICABLE.        UERT0460
C                                                                       UERT0470
C-----------------------------------------------------------------------UERT0480
C                                                                       UERT0490
      SUBROUTINE UERTST (IER,NAME)                                      UERT0500
C                                  SPECIFICATIONS FOR ARGUMENTS         UERT0510
      INTEGER            IER                                            UERT0520
      CHARACTER          NAME*(*)                                       UERT0530
C                                  SPECIFICATIONS FOR LOCAL VARIABLES   UERT0540
      INTEGER            I,IEQ,IEQDF,IOUNIT,LEVEL,LEVOLD,NAMEQ(6),      UERT0550
     *                   NAMSET(6),NAMUPK(6),NIN,NMTB                   UERT0560
      DATA               NAMSET/1HU,1HE,1HR,1HS,1HE,1HT/                UERT0570
      DATA               NAMEQ/6*1H /                                   UERT0580
      DATA               LEVEL/4/,IEQDF/0/,IEQ/1H=/                     UERT0590
C                                  UNPACK NAME INTO NAMUPK              UERT0600
C                                  FIRST EXECUTABLE STATEMENT           UERT0610
      CALL USPKD (NAME,6,NAMUPK,NMTB)                                   UERT0620
C                                  GET OUTPUT UNIT NUMBER               UERT0630
      CALL UGETIO(1,NIN,IOUNIT)                                         UERT0640
C                                  CHECK IER                            UERT0650
      IF (IER.GT.999) GO TO 25                                          UERT0660
      IF (IER.LT.-32) GO TO 55                                          UERT0670
      IF (IER.LE.128) GO TO 5                                           UERT0680
      IF (LEVEL.LT.1) GO TO 30                                          UERT0690
C                                  PRINT TERMINAL MESSAGE               UERT0700
      IF (IEQDF.EQ.1) WRITE(IOUNIT,35) IER,NAMEQ,IEQ,NAMUPK             UERT0710
      IF (IEQDF.EQ.0) WRITE(IOUNIT,35) IER,NAMUPK                       UERT0720
      GO TO 30                                                          UERT0730
    5 IF (IER.LE.64) GO TO 10                                           UERT0740
      IF (LEVEL.LT.2) GO TO 30                                          UERT0750
C                                  PRINT WARNING WITH FIX MESSAGE       UERT0760
      IF (IEQDF.EQ.1) WRITE(IOUNIT,40) IER,NAMEQ,IEQ,NAMUPK             UERT0770
      IF (IEQDF.EQ.0) WRITE(IOUNIT,40) IER,NAMUPK                       UERT0780
      GO TO 30                                                          UERT0790
   10 IF (IER.LE.32) GO TO 15                                           UERT0800
C                                  PRINT WARNING MESSAGE                UERT0810
      IF (LEVEL.LT.3) GO TO 30                                          UERT0820
      IF (IEQDF.EQ.1) WRITE(IOUNIT,45) IER,NAMEQ,IEQ,NAMUPK             UERT0830
      IF (IEQDF.EQ.0) WRITE(IOUNIT,45) IER,NAMUPK                       UERT0840
      GO TO 30                                                          UERT0850
   15 CONTINUE                                                          UERT0860
C                                  CHECK FOR UERSET CALL                UERT0870
      DO 20 I=1,6                                                       UERT0880
         IF (NAMUPK(I).NE.NAMSET(I)) GO TO 25                           UERT0890
   20 CONTINUE                                                          UERT0900
      LEVOLD = LEVEL                                                    UERT0910
      LEVEL = IER                                                       UERT0920
      IER = LEVOLD                                                      UERT0930
      IF (LEVEL.LT.0) LEVEL = 4                                         UERT0940
      IF (LEVEL.GT.4) LEVEL = 4                                         UERT0950
      GO TO 30                                                          UERT0960
   25 CONTINUE                                                          UERT0970
      IF (LEVEL.LT.4) GO TO 30                                          UERT0980
C                                  PRINT NON-DEFINED MESSAGE            UERT0990
      IF (IEQDF.EQ.1) WRITE(IOUNIT,50) IER,NAMEQ,IEQ,NAMUPK             UERT1000
      IF (IEQDF.EQ.0) WRITE(IOUNIT,50) IER,NAMUPK                       UERT1010
   30 IEQDF = 0                                                         UERT1020
      RETURN                                                            UERT1030
   35 FORMAT(19H *** TERMINAL ERROR,10X,7H(IER = ,I3,                   UERT1040
     1       20H) FROM IMSL ROUTINE ,6A1,A1,6A1)                        UERT1050
   40 FORMAT(27H *** WARNING WITH FIX ERROR,2X,7H(IER = ,I3,            UERT1060
     1       20H) FROM IMSL ROUTINE ,6A1,A1,6A1)                        UERT1070
   45 FORMAT(18H *** WARNING ERROR,11X,7H(IER = ,I3,                    UERT1080
     1       20H) FROM IMSL ROUTINE ,6A1,A1,6A1)                        UERT1090
   50 FORMAT(20H *** UNDEFINED ERROR,9X,7H(IER = ,I5,                   UERT1100
     1       20H) FROM IMSL ROUTINE ,6A1,A1,6A1)                        UERT1110
C                                                                       UERT1120
C                                  SAVE P FOR P = R CASE                UERT1130
C                                    P IS THE PAGE NAMUPK               UERT1140
C                                    R IS THE ROUTINE NAMUPK            UERT1150
   55 IEQDF = 1                                                         UERT1160
      DO 60 I=1,6                                                       UERT1170
   60 NAMEQ(I) = NAMUPK(I)                                              UERT1180
   65 RETURN                                                            UERT1190
      END                                                               UERT1200
